home *** CD-ROM | disk | FTP | other *** search
/ PC Format 25 / PCFormat 1993-10.iso / READER.ZIP / SPREDIT.BAS < prev    next >
BASIC Source File  |  1993-05-29  |  6KB  |  345 lines
  1. DECLARE SUB mb ()
  2. DECLARE SUB writ ()
  3. DECLARE SUB red ()
  4. DECLARE SUB daw ()
  5. DECLARE SUB link ()
  6. DECLARE SUB menu ()
  7. DECLARE SUB sinit ()
  8. DECLARE SUB co (c2)
  9. COMMON SHARED s, c, c1, c2, c3, c4, c5, nkpf, f, x1, y1, px1, px2, py1, py2
  10. DIM SHARED block(250)
  11. DIM SHARED bck(250)
  12. DIM SHARED store(30, 20, 25) AS INTEGER
  13. DIM SHARED sprite(5000)
  14. DIM SHARED vblock(30, 20) AS INTEGER
  15. DIM SHARED sh(500)
  16. DIM SHARED svx(2) AS INTEGER
  17. DIM SHARED svy(2) AS INTEGER
  18. KEY(1) OFF
  19. KEY(11) OFF
  20. KEY(12) OFF
  21. KEY(13) OFF
  22. KEY(14) OFF
  23. SCREEN 0
  24. PRINT "Sprite Editor, by Sam Smith. (c) 1993. Copy and alter freely but do not remove"; "this message."
  25. DO UNTIL INKEY$ <> ""
  26. LOOP
  27. menu
  28. END
  29. 1
  30. IF c1 > 1 THEN CALL co(-1)
  31. RETURN
  32. 2
  33. IF c1 < 6 THEN CALL co(1)
  34. RETURN
  35. md: DATA "1. Make Block.","2. Save Blocks.","3. Load Blocks.","4. Draw Blocks.","5. Store Sprite In File.","6. Quit."
  36. 5
  37. LINE (50 + (x1 * 8), 50 + (y1 * 14))-(58 + (x1 * 8), 64 + (y1 * 14)), c3, BF
  38. IF y1 > 1 THEN y1 = y1 - 1
  39. RETURN
  40. 6
  41. LINE (50 + (x1 * 8), 50 + (y1 * 14))-(58 + (x1 * 8), 64 + (y1 * 14)), c3, BF
  42. IF x1 > 1 THEN x1 = x1 - 1
  43. RETURN
  44. 7
  45. LINE (50 + (x1 * 8), 50 + (y1 * 14))-(58 + (x1 * 8), 64 + (y1 * 14)), c3, BF
  46. IF x1 < 30 THEN x1 = x1 + 1
  47. RETURN
  48. 8
  49. LINE (50 + (x1 * 8), 50 + (y1 * 14))-(58 + (x1 * 8), 64 + (y1 * 14)), c3, BF
  50. IF y1 < 20 THEN y1 = y1 + 1
  51. RETURN
  52. 9
  53. LOCATE 1, 5
  54. INPUT "Enter Colour:", c4
  55. RETURN
  56. 10
  57. PUT (x1, y1), bck(1), PSET
  58. IF y1 > 5 THEN y1 = y1 - 4
  59. GET (x1, y1)-(x1 + 30, y1 + 20), bck(1)
  60. PUT (x1, y1), block(1), OR
  61. RETURN
  62. 11
  63. PUT (x1, y1), bck(1), PSET
  64. IF x1 > 5 THEN x1 = x1 - 4
  65. GET (x1, y1)-(x1 + 30, y1 + 20), bck(1)
  66. PUT (x1, y1), block(1), OR
  67. RETURN
  68. 12
  69. PUT (x1, y1), bck(1), PSET
  70. IF x1 < 635 THEN x1 = x1 + 4
  71. GET (x1, y1)-(x1 + 30, y1 + 20), bck(1)
  72. PUT (x1, y1), block(1), OR
  73. RETURN
  74. 13
  75. PUT (x1, y1), bck(1), PSET
  76. IF y1 < 315 THEN y1 = y1 + 4
  77. GET (x1, y1)-(x1 + 30, y1 + 20), bck(1)
  78. PUT (x1, y1), block(1), OR
  79. RETURN
  80. 14
  81. LINE (x1, y1)-(x1, y1), c5
  82. y1 = y1 - 3
  83. c5 = POINT(x1, y1)
  84. LINE (x1, y1)-(x1, y1), 15
  85. RETURN
  86. 15
  87. LINE (x1, y1)-(x1, y1), c5
  88. x1 = x1 - 3
  89. c5 = POINT(x1, y1)
  90. LINE (x1, y1)-(x1, y1), 15
  91. RETURN
  92. 16
  93. LINE (x1, y1)-(x1, y1), c5
  94. x1 = x1 + 3
  95. c5 = POINT(x1, y1)
  96. LINE (x1, y1)-(x1, y1), 15
  97. RETURN
  98. 17
  99. LINE (x1, y1)-(x1, y1), c5
  100. y1 = y1 + 3
  101. c5 = POINT(x1, y1)
  102. LINE (x1, y1)-(x1, y1), 15
  103. RETURN
  104.  
  105. SUB co (c2)
  106. COLOR 15
  107. IF c1 = 6 AND c2 = 1 THEN GOTO fs
  108. IF c1 = 1 AND c2 = -1 THEN GOTO fs
  109. c1 = c1 + c2
  110. IF c2 = -1 THEN GOSUB 3 ELSE GOSUB 4
  111. RESTORE md
  112. FOR cou = 1 TO c1
  113. READ c$
  114. NEXT cou
  115. LINE (63, 85 + (c1 * 14))-(65 + (LEN(c$) * 9), 97 + (c1 * 14)), 1, BF, 1
  116. GET (63, 85 + (c1 * 14))-(65 + (LEN(c$) * 9), 97 + (c1 * 14)), sh(1)
  117. LOCATE 7 + c1, 10
  118. PRINT c$
  119. PUT (63, 85 + (c1 * 14)), sh(1), XOR
  120. GOTO fs
  121. 3
  122. RESTORE md
  123. FOR cou = 1 TO 6
  124. READ c$
  125. IF cou = c1 + 1 THEN LOCATE 7 + cou, 8 ELSE GOTO el
  126. PRINT " " + c$ + "    "
  127. el:
  128. NEXT cou
  129. RETURN
  130. 4
  131. RESTORE md
  132. FOR cou = 1 TO 6
  133. READ c$
  134. IF cou = c1 - 1 THEN LOCATE 7 + cou, 8 ELSE GOTO el1
  135. PRINT " " + c$ + "    "
  136. el1:
  137. NEXT cou
  138. RETURN
  139. fs:
  140. END SUB
  141.  
  142. SUB daw
  143. CLS
  144. INPUT f$
  145. PUT (px1 + 1, py1 + 1), sprite(1), XOR
  146. OPEN f$ FOR OUTPUT AS #1
  147. PRINT #1, px1
  148. PRINT #1, px2
  149. PRINT #1, py1
  150. PRINT #1, py2
  151. FOR c = px1 TO px2
  152. FOR c2 = py1 TO py2
  153. PRINT #1, POINT(c, c2)
  154. NEXT c2
  155. NEXT c
  156. CLOSE #1
  157. CLS
  158. PUT (0, 0), sprite(1), XOR
  159. a$ = ""
  160. DO UNTIL a$ <> ""
  161. a$ = INKEY$
  162. LOOP
  163. END SUB
  164.  
  165. SUB link
  166. CLS
  167. KEY(1) ON
  168. KEY(12) ON
  169. KEY(13) ON
  170. ON KEY(11) GOSUB 10
  171. ON KEY(12) GOSUB 11
  172. ON KEY(13) GOSUB 12
  173. ON KEY(14) GOSUB 13
  174. s = 1
  175. DO UNTIL s = 0
  176. INPUT "Enter Slot: ", s
  177. FOR c = 1 TO 250
  178. bck(c) = 0
  179. block(c) = 0
  180. NEXT c
  181. FOR x1 = 1 TO 30
  182. FOR y1 = 1 TO 20
  183. LINE (x1, y1)-(x1, y1), store(x1, y1, s)
  184. NEXT y1
  185. NEXT x1
  186. x1 = 1
  187. x2 = 1
  188. GET (1, 1)-(30, 20), block(1)
  189. LINE (0, 0)-(640, 50), 0, BF
  190. GET (1, 1)-(30, 20), bck(1)
  191. LOCATE 1, 1
  192. i$ = ""
  193. DO UNTIL i$ = "E"
  194. LOCATE 1, 1
  195. PRINT "X: "; x1; "."
  196. PRINT "Y: "; y1; "."
  197. i$ = INKEY$
  198. LOOP
  199. LOOP
  200. ON KEY(11) GOSUB 14
  201. ON KEY(12) GOSUB 15
  202. ON KEY(13) GOSUB 16
  203. ON KEY(14) GOSUB 17
  204. FOR c = 1 TO 2
  205. a$ = ""
  206. x1 = 50
  207. y1 = 50
  208. c5 = POINT(x1, y1)
  209. LINE (x1, y1)-(x1, y1), 15
  210. DO UNTIL a$ <> ""
  211. LOCATE 1, 1
  212. PRINT "X: "; x1; "."
  213. PRINT "Y: "; y1; "."
  214. a$ = INKEY$
  215. LOOP
  216. svx(c) = x1
  217. svy(c) = y1
  218. NEXT c
  219. GET (svx(1) + 1, svy(1) + 1)-(svx(2) - 1, svy(2) - 1), sprite(1)
  220. px1 = svx(1)
  221. py1 = svy(1)
  222. px2 = svx(2)
  223. py2 = svy(2)
  224. KEY(12) OFF
  225. KEY(13) OFF
  226. END SUB
  227.  
  228. SUB mb
  229. KEY(1) ON
  230. KEY(12) ON
  231. KEY(13) ON
  232. ON KEY(11) GOSUB 5
  233. ON KEY(12) GOSUB 6
  234. ON KEY(13) GOSUB 7
  235. ON KEY(14) GOSUB 8
  236. ON KEY(1) GOSUB 9
  237. CLS
  238. INPUT "Enter slot:", s
  239. CLS
  240. FOR x1 = 1 TO 30
  241. FOR y1 = 1 TO 20
  242. vblock(x1, y1) = store(x1, y1, s)
  243. c3 = vblock(x1, y1)
  244. LINE (50 + (x1 * 8), 50 + (y1 * 14))-(58 + (x1 * 8), 64 + (y1 * 14)), c3, BF
  245. LINE (x1, y1)-(x1, y1), store(x1, y1, s)
  246. NEXT y1
  247. NEXT x1
  248. f = 0
  249. x1 = 1
  250. y1 = 1
  251. DO UNTIL f = -1
  252. c3 = vblock(x1, y1)
  253. LINE (50 + (x1 * 8), 50 + (y1 * 14))-(58 + (x1 * 8), 64 + (y1 * 14)), 15, BF
  254. LINE (x1, y1)-(x1, y1), vblock(x1, y1)
  255. i$ = INKEY$
  256. IF i$ = "E" THEN f = -1
  257. IF i$ = CHR$(13) THEN vblock(x1, y1) = c4
  258. LOOP
  259. KEY(1) OFF
  260. KEY(12) OFF
  261. KEY(13) OFF
  262. INPUT "Enter slot:", s
  263. FOR x1 = 1 TO 30
  264. FOR y1 = 1 TO 20
  265. store(x1, y1, s) = vblock(x1, y1)
  266. NEXT y1
  267. NEXT x1
  268. END SUB
  269.  
  270. SUB menu
  271. SCREEN 9
  272. ndr:
  273. KEY(11) ON
  274. KEY(14) ON
  275. ON KEY(11) GOSUB 1
  276. ON KEY(14) GOSUB 2
  277. CLS
  278. LINE (0, 0)-(600, 330), 10, B
  279. RESTORE md
  280. FOR cob = 1 TO 6
  281. READ a$
  282. LOCATE 7 + cob, 10
  283. PRINT a$
  284. NEXT cob
  285. LOCATE 5, 8
  286. COLOR 14
  287. PRINT "Options."
  288. LINE (50, 72)-(123, 72), 9
  289. CALL sinit
  290. f = 0
  291. c1 = 1
  292. DO UNTIL f = -1
  293. i$ = INKEY$
  294. IF i$ = CHR$(13) THEN f = -1
  295. LOOP
  296. IF c1 = 6 THEN GOTO em
  297. IF c1 = 1 THEN CALL mb
  298. IF c1 = 4 THEN CALL link
  299. KEY(11) OFF
  300. KEY(14) OFF
  301. IF c1 = 2 THEN CALL writ
  302. IF c1 = 3 THEN CALL red
  303. IF c1 = 5 THEN daw
  304. GOTO ndr:
  305. em:
  306. END SUB
  307.  
  308. SUB red
  309. CLS
  310. INPUT "Enter Filename: ", f$
  311. OPEN f$ FOR INPUT AS #1
  312. FOR x1 = 1 TO 30
  313. FOR y1 = 1 TO 20
  314. FOR s = 0 TO 25
  315. INPUT #1, store(x1, y1, s)
  316. NEXT s
  317. NEXT y1
  318. NEXT x1
  319. CLOSE #1
  320. END SUB
  321.  
  322. SUB sinit
  323. FOR c = 1 TO 6
  324. CALL co(1)
  325. NEXT c
  326. FOR c = 1 TO 5
  327. CALL co(-1)
  328. NEXT c
  329. END SUB
  330.  
  331. SUB writ
  332. CLS
  333. INPUT "Enter Filename: ", f$
  334. OPEN f$ FOR OUTPUT AS #1
  335. FOR x1 = 1 TO 30
  336. FOR y1 = 1 TO 20
  337. FOR s = 0 TO 25
  338. PRINT #1, store(x1, y1, s)
  339. NEXT s
  340. NEXT y1
  341. NEXT x1
  342. CLOSE #1
  343. END SUB
  344.  
  345.